home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / dump_s1r / clsprope.cls < prev    next >
Text File  |  1998-12-19  |  2KB  |  67 lines

  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "clsProperties"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = False
  10. Private Properties As New Collection
  11. Public Sub AddProperty(Name, ObjectName, Value, Object As Object)
  12. If Not ReturnProperty(CStr(ObjectName), CStr(Name)) Is Nothing Then Exit Sub
  13. Dim nProp As New clsProperty
  14. nProp.PName = Name
  15. nProp.PObjectName = ObjectName
  16. nProp.PValue = Value
  17. Set nProp.ObjectReferense = Object
  18. Properties.Add nProp
  19. End Sub
  20.  
  21. Public Function ReturnProperty(ObjectName As String, PropertyName As String) As clsProperty
  22. Dim CP As clsProperty, I As Long
  23. For I = 1 To Count
  24. Set CP = Properties(I)
  25. If CP.PObjectName = ObjectName And CP.PName = PropertyName Then
  26. Set ReturnProperty = CP
  27. End If
  28. Next
  29. End Function
  30.  
  31. Public Property Get Count() As Long
  32. Count = Properties.Count
  33. End Property
  34.  
  35. Public Sub Clear()
  36. For I = 1 To Properties.Count
  37. Properties.Remove 1
  38. Next
  39. End Sub
  40.  
  41. Public Sub DeleteProperty(ObjectName As String, PropertyName As String)
  42. Dim CP As clsProperty, I As Long
  43. For I = 1 To Count
  44. Set CP = Properties(I)
  45. If CP.PObjectName = ObjectName And CP.PName = PropertyName Then
  46. Properties.Remove I
  47. Exit Sub
  48. End If
  49. Next
  50. End Sub
  51.  
  52. Public Function RetPropsbByPName(PropertyName As String) As Collection
  53. Set RetPropsbByPName = New Collection
  54. Dim CP As clsProperty, I As Long
  55. For I = 1 To Count
  56. Set CP = Properties(I)
  57. If CP.PName = PropertyName Then
  58. RetPropsbByPName.Add CP
  59. End If
  60. Next
  61. End Function
  62.  
  63. Public Function ReturnPByIdx(Index As Long) As clsProperty
  64. On Error Resume Next
  65. Set ReturnPByIdx = Properties(Index)
  66. End Function
  67.